<xsl:stylesheet xmlns:xsl="http://www.w3.org/TR/WD-xsl">
<xsl:template match="/">
<HTML>
<STYLE>
   .userData {behavior:url(#default#userdata);}
</STYLE>

<HEAD>

<TITLE>XML Results Page</TITLE>
<LINK REL="STYLESHEET" HREF="xmlquery/dbstyle.css" TYPE="text/css"/>

<SCRIPT language="vbscript">
<xsl:comment><![CDATA[
Function RegRepl(S, Search1, Search2, Search3, Search4, Repl1, Repl2)
	Dim Result, regEx,i, Matches, Match, Found(512), FoundIdx, Value
	result = S
	FoundIDx = 0
	Found(0) = ""

	Set regEx = New RegExp
   	regEx.IgnoreCase = True
   	regEx.Global = True
   	regEx.Pattern = Search1
   	Set Matches = regEx.Execute(result)
	For Each Match in Matches ' Iterate matches
		i = 0
		while i<FoundIdx and (Found(i) <> Match.SubMatches(0))
			i = i + 1
		wend
		if i=FoundIdx then
			Found(FoundIdx) = Match.SubMatches(0)
			FoundIdx = FoundIdx + 1
			Value = oPersistDiv.getAttribute(Match.SubMatches(0))
			regEx.Pattern = Search2+Match.SubMatches(0)+Search3+Match.SubMatches(0)+Search4
			if Value <> "" then
				if Repl1 = "^^value" then
					Result = regEx.Replace(Result, Value)
				else
					Result = regEx.Replace(Result, Repl1)
				end if
			else
				if Repl2 = "^^value" then
					Result = regEx.Replace(Result, Value)
				else
					Result = regEx.Replace(Result, Repl2)
				end if
			end if
		end if
  	Next
  	RegRepl = Result
End Function

Function ParseQuery(S)
	Dim Result
	result = S
	Result = RegRepl(Result,"/\*start-([^*]*)\*/", _
		".\*start-","\*/((.|\n)*?)/\*end-","\*/", _
		"^^value", "$1")

	Result = RegRepl(Result,"/\*ifdef-([^*]*)\*/", _
		".\*ifdef-","\*/((.|\n)*?)/\*endifdef-","\*/", _
		"$1", "")

	Result = RegRepl(Result,"/\*ifndef-([^*]*)\*/", _
		".\*ifndef-","\*/((.|\n)*?)/\*endifndef-","\*/", _
		"", "$1")

	ParseQuery = result
End Function

Function AddXMLNodeEx( DOMXML, Parent, Name, Value, Attribute, AttValue, NameSpace )
    Dim objNode
    Set objNode = DOMXML.createNode( "element", LCase(Name), NameSpace)
    If Len(Value) <> 0 then
        objNode.text = Trim(Value)
    End If
    if Attribute <> "" then
	objNode.setAttribute Attribute, AttValue
    end if
    Parent.AppendChild objNode
    Set AddXMLNodeEx = objNode
End Function

Function DoErrors(cnn,Msg)
    Dim Result, Err1

    Result = 0
    If cnn.Errors.Count > 0 Then
        	For Each Err1 In cnn.Errors
        		if (Err1.NativeError <> 5701) and (Err1.NativeError <> 5703) and (StopProc = 0) and _
        		(InStr(1,Err1.Description, "If DBCC printed error messages") = 0) and _
        		(Instr(1,Err1.Description, "Use 'DBCC TRACEON()'") = 0) then
        			if Msg <> "" then
					MsgBox(Msg)
				else
                	    		ErrMess = Err1.Description
	                	        if Mid(ErrMess,1,11) = "[Microsoft]" then ErrMess = Mid(ErrMess,12)
        	        	        if Mid(ErrMess,1,24) = "[ODBC SQL Server Driver]" then ErrMess = Mid(ErrMess,25)
                		        if Mid(ErrMess,1,12) = "[SQL Server]" then ErrMess = Mid(ErrMess,13)
                		    	if Err1.SQLState = "01000" then
	                    			MsgBox(ErrMess & " | " & Err1.NativeError)
	        			else
        	            			MsgBox("Error " & Err1.SQLState & ": " & _
                	        			ErrMess & " | " & Err1.NativeError)
                        		end if
                        	end if
                    		Result = 1
                    	end if
     		Next
     end if
     cnn.Errors.Clear
     DoErrors = Result
End Function

Function FieldType(Typ)
   Select Case Typ
'      Case 7,133,134,135,64 AdoToSort = "date("+Field+")"
      Case 20,6,14,5,3,131,4,2,16,17,18,19,21,139 FieldType = "number"
      Case Else FieldType = "text"
   End Select
End Function

Function ProcRecordSet(rs,r,objXML,objResults)
    	RsetS = CStr(r)

    	Set objTable = AddXMLNodeEx( objXML, objResults, "table", "", "","", "" )
	if rs.Fields.Count > 0 then
		objTable.setAttribute "sortColumn", "none"
		objTable.setAttribute "sortOrder", "ascending"
		objTable.setAttribute "sortType", FieldType(rs.Fields(0).Type)
	end if

	for x = 0 to rs.Fields.Count - 1
		xS = CStr(x)
	    	Set objColumns = AddXMLNodeEx( objXML, objTable, "column", "", "","", "" )
	    	Set objName = AddXMLNodeEx( objXML, objColumns, "name", Trim(rs.Fields(x).Name), "","", "" )
	    	Set objType = AddXMLNodeEx( objXML, objColumns, "type", FieldType(rs.Fields(x).Type), "","", "" )
    	Next

	Table = rs.GetRows
    	ColNum = UBound(Table, 1)
    	for i = 0 to UBound(Table, 2)
        	Set objNode = AddXMLNodeEx( objXML, objTable, "row", "", "","", "" )
		for j = 0 to ColNum
            		AddXMLNodeEx objXML, objNode, "v"+CStr(j), (Table(j,i)), "","", ""
	        Next
	Next

End Function

Function RecordsetToXMLDoc(rs,objXML, objResults)
    Dim objNode, x, MyNewNode, r, RsetS

    r = 0
    Do Until (Rs Is Nothing)
        if Rs.State = 1 then
	    	if (rs.Fields.Count > 0) and not rs.Eof then
      			r = r + 1
	    		RsetS = CStr(r)
	    		ProcRecordSet rs,r, objXML, objResults
		end if
        end if
       Set Rs = Rs.NextRecordset
    Loop

End Function


Function GetData(source,DisplayXSL)
	Dim cnn,rs, Result, ConnOpened, Query, OraHome

	oPersistDiv.load("oXMLStore")
	ConnOpened = 0
	set xmlResult = CreateObject("Msxml2.DOMDocument")
	xmlResult.async = False
	xmlResult.resolveExternals = False

	Set objResults = AddXMLNodeEx( xmlResult, xmlResult, "data", "", "","", "" )

	set nodes = source.childNodes(1).childNodes
	for i=0 to nodes.length -1
		if nodes.item(i).nodeName = "query" then
			if ConnOpened = 0 then
				ConnOpened = 1
				if Server = "" then
					set xmlConnect = CreateObject("Msxml2.DOMDocument")

					xmlConnect.async = False
					xmlConnect.resolveExternals = False
					xmlConnect.Load("xmlquery/connect.xml")
					set xmlServer = xmlConnect.selectNodes("//server")
					if xmlServer.length > 0 then
						Server = xmlServer.Item(0).text
					else
		    				Server = "Provider=MSDASQL;Driver={SQL Server};Server=localhost;Database=master;Trusted_Connection=Yes"
					end if

				end if

				Set cnn = CreateObject("ADODB.Connection")
				cnn.Open Server
				cnn.Errors.Clear

				if DoErrors(cnn,"Cannot connect to "+Server) = 0 then

					Query = ParseQuery(nodes.Item(i).text)

					'MsgBox(Query)
					on Error resume next
		    			Set rs = cnn.Execute(Query)

	    				er = DoErrors(cnn,"")
			    		cnn.Errors.Clear
			    		on Error goto 0

	    				if IsObject(Rs) then
	    					RecordsetToXMLDoc rs,xmlResult, objResults
		    			end if
	    			end if
			end if
		elseif nodes.item(i).nodeName = "include" then
			set xmlConnect = CreateObject("Msxml2.DOMDocument")
			xmlConnect.async = False
			xmlConnect.resolveExternals = False
			xmlConnect.Load(nodes.item(i).text)
			'MsgBox(xmlConnect.xml)
			Temp = ParseQuery(xmlConnect.xml)
			xmlConnect.loadXML(Temp)
			objResults.appendChild(xmlConnect.ChildNodes(0))
		elseif nodes.item(i).nodeName = "table" then
	        	set newnode = nodes.item(i).cloneNode(True)
	        	objResults.appendChild(newnode)
	        else
	        	set newnode = nodes.item(i).cloneNode(True)
	        	DisplayXSL.childNodes.item(0).appendChild(newnode)
'	        	MsgBox(newnode.xml)
	        end if
        next
	if ConnOpened = 1 then
		cnn.close
	end if
	set GetData = xmlResult
End Function

Function BuildXSL()
    set xsl = CreateObject("Msxml2.DOMDocument")

    xsl.async = False
    xsl.resolveExternals = False
    xsl.Load("xmlquery/generic.xsl")
    set BuildXSL = xsl
End Function

]]></xsl:comment>
</SCRIPT>

<SCRIPT language="javascript">
<![CDATA[
	var sortField = null;
	var sortOrder = null;
	var dta = null;
	var DisplayXSL = null;
	var Result = null;
	var Server = "";
	var stylesheet = null;
	var source = null;

	function display()
	{
		Result = dta.transformNode(DisplayXSL)
		Bdy.innerHTML = Result;
	}
]]>
</SCRIPT>

<SCRIPT language="vbscript">
<![CDATA[
Function sort(field)
	Dim Pars
	Pars = Split(field,",")
	if UBound(Pars,1) = 2 then
		Tab=CInt(Pars(0))
		Col=Pars(1)
		Typ=Pars(2)
		if dta.selectSingleNode("/data/table["+CStr(Tab-1)+"]/@sortColumn").value = "v"+CStr(Col) then
			if dta.selectSingleNode("/data/table["+CStr(Tab-1)+"]/@sortOrder").value = "ascending" then
				dta.selectSingleNode("/data/table["+CStr(Tab-1)+"]/@sortOrder").value = "descending"
			else
				dta.selectSingleNode("/data/table["+CStr(Tab-1)+"]/@sortOrder").value = "ascending"
			end if
		else
			dta.selectSingleNode("/data/table["+CStr(Tab-1)+"]/@sortColumn").value = "v"+CStr(Col)
			dta.selectSingleNode("/data/table["+CStr(Tab-1)+"]/@sortType").value = Typ
			dta.selectSingleNode("/data/table["+CStr(Tab-1)+"]/@sortOrder").value = "ascending"
		end if
		display()
	else
		MsgBox("Wrong number of params")
	end if
End Function

Function DoSQL(query)
	Set cnn = CreateObject("ADODB.Connection")
	cnn.Open Server
	cnn.Errors.Clear
	if DoErrors(cnn,"Cannot connect to "+Server) = 0 then
		on Error resume next
		Query = ParseQuery(nodes.Item(i).text)

    	cnn.Execute(query)

		er = DoErrors(cnn,"")
    		cnn.Errors.Clear
    		on Error goto 0
	end if
	cnn.close

	document.location.reload
End Function
]]>
</SCRIPT>


<xsl:apply-templates select="query"/>

<SCRIPT language="vbscript" for="window" event="onload">

<![CDATA[
	set source = document.XMLDocument
	set DisplayXSL = buildXSL

	set dta = GetData(source,DisplayXSL)
	if not IsNull(dta) then
		Result = dta.transformNode(DisplayXSL)
		Bdy.innerHTML = Result
	end if
'	InitMenu()
]]>


</SCRIPT>

   <SCRIPT LANGUAGE="JScript">

   var normalColor, selectedElement;
   selectedElement = null;

   function Hilite()
   {
   	if (event.srcElement.className == "selectable" || event.srcElement.className == "header" ||
   	event.srcElement.className == "Button" || event.srcElement.className == "RedButton" ||
   	event.srcElement.className == "GreenButton" || event.srcElement.tagName == "TH")
   	{
		normalColor = event.srcElement.style.backgroundColor;

		event.srcElement.style.backgroundColor = "A5BACE";
		event.srcElement.style.cursor = "hand";
		selectedElement = event.srcElement;
	}
   }

   function Restore()
   {
	if (selectedElement != null)
	{
		selectedElement.style.backgroundColor = normalColor;
		selectedElement.style.cursor = "";
		selectedElement = null;
	}
   }

   </SCRIPT>

</HEAD>
<BODY onmouseover="Hilite()" onmouseout="Restore()">

	<DIV CLASS="userData" ID="oPersistDiv"></DIV>
	<DIV ID="Bdy"></DIV>
</BODY>
</HTML>

</xsl:template>

</xsl:stylesheet>
